home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / menus.tcl < prev    next >
Encoding:
Text File  |  1997-12-20  |  20.0 KB  |  759 lines  |  [TEXT/ALFA]
  1. # Menu creation procs
  2.     
  3. namespace eval menu {}
  4. namespace eval global {}
  5. namespace eval file {}
  6.  
  7. proc menu::buildBasic {} {
  8.     global winMenu HOME
  9.     # These are built on the fly
  10.     menu -n File -p menu::generalProc {}
  11.     menu -n Edit -p menu::generalProc {}
  12.     menu -n Text -p menu::generalProc {}
  13.     menu -n Search {}
  14.     menu -n Utils {}
  15.     menu -n Config {}
  16.     menu -n $winMenu {}
  17.     
  18.     insertMenu "File"
  19.     insertMenu "Edit"
  20.     insertMenu "Text"
  21.     insertMenu "Search"
  22.     insertMenu "Utils"
  23.     insertMenu "Config"
  24.     insertMenu $winMenu
  25.  
  26.     if {![catch {glob "$HOME:Help:*"} files]} {
  27.         set men { "Alpha Manual" "Quick Start" "Alpha Commands" "Tcl Commands" \
  28.             "(-" "Readme" "Changes" \
  29.             "Extending Alpha" "Bug Reports and Debugging" "(-" }
  30.         foreach f $men {
  31.             if {$f != "(-" && ![file exists "${HOME}:Help:$f"]} {
  32.                 set men [lremove $men $f]
  33.             }
  34.         }
  35.         set ignore "" 
  36.         foreach f [lsort $files] {
  37.             set f [file tail $f]
  38.             if {[lsearch $men $f] < 0 && [lsearch $ignore $f] < 0} {
  39.                 lappend men $f
  40.             }
  41.         }
  42.         regsub -all {\(-[ \t\r\n]+\(-} $men {\(-} men
  43.         foreach f $men {
  44.             addHelpMenu $f
  45.         }
  46.     }
  47.     
  48. }
  49.  
  50. proc menu::buildwinMenu {} {
  51.     global winMenu winNameToNum
  52.     set ma {
  53.             "//<Szoom"
  54.             "//<S<I<OsinglePage"
  55.             "<S/;chooseAWindow"
  56.             "/I<Biconify"
  57.             {menu -n arrange -p menu::winTileProc {
  58.                 "/Jvertically^1"
  59.                 "/J<O<Ihorizontally^2"
  60.                 "/J<B<OunequalVert^6"
  61.                 "/J<B<I<OunequalHor^5"
  62.                 "(-"
  63.                 {menu -n other {
  64.                     {bufferOtherWindow}
  65.                     {iconify}
  66.                     {nextWin}
  67.                     {nextWindow}
  68.                     {prevWindow}
  69.                     {shrinkFull}
  70.                     {shrinkHigh}
  71.                     {shrinkLeft}
  72.                     {shrinkLow}
  73.                     {shrinkRight}
  74.                     {singlePage}
  75.                     {swapWithNext}
  76.                     {zoom}
  77.                 }}}}
  78.             "(-"
  79.             "/msplitWindow"
  80.             "/otoggleScrollbar"
  81.             "(-"
  82.     }
  83.     # We may be reloading, so add whatever windows we have
  84.     if {[info exists winNameToNum]} {
  85.         set nms [array names winNameToNum]
  86.         foreach name $nms {
  87.             regexp {[^:]*$} $name item
  88.             set num $winNameToNum($name)
  89.             if {$num < 10}     {
  90.                 lappend ma /$num${item}
  91.             } else {
  92.                 lappend ma ${item}
  93.             }
  94.         }
  95.     }
  96.     return [list "build" $ma menu::winProc "" $winMenu]
  97. }
  98.  
  99. proc global::listAllBindings {} {
  100.     new -n {* All Key Bindings *} -m Tcl
  101.     insertText [bindingList]
  102.     winReadOnly
  103. }
  104.  
  105. proc global::listGlobalBindings {} {
  106.     global modeMenus
  107.     new -n {* Global Key Bindings *} -m Tcl
  108.     set text ""
  109.     foreach b [split [bindingList] "\r"] {
  110.         set lst [lindex $b end]
  111.         if {[lsearch [lsort -ignore [array names modeMenus]] $lst] < 0} {
  112.             append text "$b\r"
  113.         }
  114.     }
  115.     insertText $text
  116.     winReadOnly
  117. }
  118.  
  119. proc global::listPackages {} {
  120.     cache::read index::maintainer
  121.     foreach i [array names index::maintainer] {
  122.         set j [lindex [set index::maintainer($i)] 1]
  123.         set au($i) "[lindex $j 0], [lindex $j 1]"
  124.     }
  125.     new -n {* Installed Packages *} -m Text
  126.     append t "Currently installed packages\r\r"
  127.     append t "columns are: name, version, and maintainer\r\r"
  128.     append t "Extensions ('•' = active):"
  129.     insertText $t ; set t ""
  130.     foreach p [lsort -ignore [alpha::package names -extension]] {
  131.         foreach v [alpha::package versions $p] {
  132.             append t "\r[format {%s %-25s %-10s  } [package::active $p {• { }}] $p $v]"
  133.             if [info exists au($p)] {append t $au($p)}
  134.         }
  135.     }
  136.     append t "\r\rMenus:"
  137.     insertText $t ; set t ""
  138.     foreach p [lsort -ignore [alpha::package names -menu]] {
  139.         foreach v [alpha::package versions $p] {
  140.             append t "\r[format {  %-25s %-10s  } $p $v]"
  141.             if [info exists au($p)] {append t $au($p)}
  142.         }
  143.     }
  144.     append t "\r\rModes:"
  145.     insertText $t ; set t ""
  146.     foreach p [lsort -ignore [alpha::package names -mode]] {
  147.         foreach v [alpha::package versions $p] {
  148.             append t "\r[format {  %-8s %-10s  } $p $v]"
  149.             if [info exists au($p)] {append t $au($p)}
  150.         }
  151.     }
  152.     insertText $t ; set t ""
  153.     winReadOnly
  154.     shrinkWindow
  155. }
  156.  
  157. proc global::listFunctions {} {
  158.     global win::Modes
  159.     new -n {* Functions *} -m Tcl
  160.     insertText "===\r\tCommand-double-click on a function to see its definition\r===\r\r" [join [lsort -ignore [info commands]] "\r"] "\r"
  161.     winReadOnly
  162. }
  163.  
  164. proc global::menus {} {
  165.     global menus globalMenus_curr modifiedVars modeMenus mode
  166.     
  167.     set newGlobals [dialog::pickMenus global]
  168.     set removed [lremove -l $globalMenus_curr $newGlobals]
  169.     set added [lremove -l $newGlobals $globalMenus_curr]
  170.     set globalMenus_curr $newGlobals
  171.     lappend    modifiedVars globalMenus_curr
  172.     # now synchronise menus, paying attention to current mode menus
  173.     if {[info exists modeMenus($mode)]}    {
  174.         set removed [lremove -l $removed $modeMenus($mode)]
  175.         set added [lremove -l $added $modeMenus($mode)]
  176.     }
  177.     # remove removed menus
  178.     foreach m $removed {
  179.         global $m
  180.         if {[info exists $m]} {
  181.             catch "removeMenu [set $m]"
  182.             catch {markMenuItem packageMenus $m 0}
  183.         }
  184.     }
  185.     foreach    m $added {
  186.         global $m
  187.         catch $m
  188.         insertMenu [set    $m]
  189.         catch {markMenuItem packageMenus $m 1}
  190.     }
  191. }
  192.  
  193. proc global::insertAllMenus {} {
  194.     global globalMenus_curr
  195.     foreach m $globalMenus_curr {
  196.         if {![catch $m res]} {
  197.             global $m
  198.             if {[info exists $m]} {
  199.                 insertMenu [set $m]
  200.             }
  201.         } else {
  202.             alpha::error $res
  203.             lappend problems $m
  204.         }
  205.     }
  206.     if {[info exists problems]} {
  207.         alertnote "Problems building menus: $problems"
  208.     }
  209. }
  210.  
  211. ## 
  212.  # -------------------------------------------------------------------------
  213.  # 
  214.  # "menu::buildProc" --
  215.  # 
  216.  #  Register a procedure to be the 'build proc' for a given menu.  This
  217.  #  procedure can do one of two things:
  218.  #  
  219.  #  i) build the entire menu, including evaluating the 'menu ...' command.
  220.  #  In this case the build proc should return anything which doesn't
  221.  #  begin 'build ...'
  222.  #  
  223.  #  ii) build up part of the menu, and then allow pre-registered menu
  224.  #  insertions/replacements to take-effect.  In this case the procedure
  225.  #  should return a list of the items (listed by index):
  226.  #  
  227.  #  0: "build"
  228.  #  1: list-of-items-in-the-menu
  229.  #  2: list of other flags.  If the list doesn't contain '-p', we use
  230.  #  the standard menu::generalProc procedure.  If it does contain '-p'
  231.  #  general prmenu procedure to call when an item is selected.  
  232.  #  If nothing is given,
  233.  #  or if '-1' is given, then we don't have a procedure.  If "" is given,
  234.  #  we use the standard 'menu::generalProc' procedure.  Else we use the
  235.  #  given procedure.
  236.  #  3: list of submenus which need building.
  237.  #  4: over-ride for the name of the menu.
  238.  #  
  239.  #  You must register the build-proc before attempting to build the menu.
  240.  #  Once registered, any call of 'menu::buildSome name' will build your
  241.  #  menu.
  242.  # -------------------------------------------------------------------------
  243.  ##
  244. proc menu::buildProc {name proc} {
  245.     global menu::build_procs
  246.     set menu::build_procs($name) $proc
  247. }
  248.  
  249. ## 
  250.  # -------------------------------------------------------------------------
  251.  # 
  252.  # "menu::insert" --
  253.  # 
  254.  #  name, type, where, then list of items.  type = 'items' 'submenu'
  255.  #  
  256.  #  Add given items to a given menu, provided they are not already there.
  257.  #  Rebuild that menu if necessary.
  258.  #  
  259.  #  There are also procs 'menu::removeFrom' which does the opposite of
  260.  #  this one, and 'menu::replaceWith' which replaces a given menu item
  261.  #  with others.
  262.  # -------------------------------------------------------------------------
  263.  ##
  264. proc menu::insert {name args} {
  265.     if {[llength $args] < 3} { error "Too few args to menu::insert" }
  266.     global menu::additions alpha::noMenusYet
  267.     if [info exists menu::additions($name)] {
  268.         set a [set menu::additions($name)]
  269.         if {[lsearch -exact $a $args] != -1} { 
  270.             return 
  271.         }
  272.         # check if it's there but in a different place; we over-ride
  273.         set dblchk [lreplace $args 1 1 "*"]
  274.         if {[set i [lsearch -glob $a $dblchk]] == -1} {
  275.             unset i
  276.         }
  277.     }
  278.     if [info exists i] {
  279.         set menu::additions($name) [lreplace $a $i $i $args]
  280.     } else {
  281.         lappend menu::additions($name) $args
  282.     }
  283.     if ![info exists alpha::noMenusYet] {
  284.         # we were called after start-up; build the menu now
  285.         menu::buildSome $name
  286.     }
  287. }
  288.  
  289. proc menu::uninsert {name args} {
  290.     global menu::additions alpha::noMenusYet
  291.     set a [set menu::additions($name)]
  292.     if {[set idx [lsearch -exact $a $args]] == -1} { 
  293.         return 
  294.     }
  295.     set menu::additions($name) [lreplace $a $idx $idx]
  296.     if ![info exists alpha::noMenusYet] {
  297.         # we were called after start-up; build the menu now
  298.         menu::buildSome $name
  299.     }
  300. }
  301.  
  302. proc alpha::buildMainMenus {} {
  303.     menu::buildProc alphaDownloads remote::makeDownloadsMenu
  304.     menu::buildProc packages package::makeMenu
  305.     menu::buildProc global menu::globalBuild
  306.     menu::buildProc mode menu::modeBuild
  307.     menu::buildProc winMenu menu::buildwinMenu
  308.     menu::buildProc preferences menu::preferencesBuild
  309.     uplevel #0 {
  310.     source "$HOME:Tcl:SystemCode:alphaMenus.tcl"
  311.     menu::buildSome "File" "Edit" "Text" "Search" "Utils" "Config" "winMenu"
  312.     }
  313. }
  314.  
  315. ## 
  316.  # -------------------------------------------------------------------------
  317.  # 
  318.  # "menu::buildSome" --
  319.  # 
  320.  #  Important procedure which builds all known/registered menus from a
  321.  #  number of pieces.  It allows the inclusion of menus pieces registered
  322.  #  with the menu::insert procedure, which allows you easily to add items
  323.  #  (including dynamic and hierarchial) to any of Alpha's menus.
  324.  # 
  325.  # Results:
  326.  #  Various menus are (re)built
  327.  # 
  328.  # Side effects:
  329.  #  Items added to those menus with 'addMenuItem' will vanish.
  330.  # 
  331.  # --Version--Author------------------Changes-------------------------------
  332.  #    1.0     <darley@fas.harvard.edu> original
  333.  #    2.0     <darley@fas.harvard.edu> more compact, more like tk
  334.  # -------------------------------------------------------------------------
  335.  ##
  336. proc menu::buildSome {args} {
  337.     set msubs ""
  338.     foreach token $args {
  339.         eval lappend msubs [menu::buildOne $token]
  340.     }
  341.     # build sub-menus of those built
  342.     if {$msubs != ""} {eval menu::buildSome $msubs}
  343. }
  344.  
  345. proc menu::buildOne {args} {
  346.     global menu::additions menu::build_procs alpha::noMenusYet \
  347.       menu::items
  348.     set token [lindex $args 0] ; set args [lrange $args 1 end]
  349.     if {[set len [llength $args]] > 0 || [info exists menu::build_procs($token)]} {
  350.         if {$len > 0} {
  351.             set res $args
  352.         } else {
  353.             if [catch "[set menu::build_procs($token)]" res] {
  354.                 alpha::error "The menu $token had a problem starting up ; $res"
  355.             }
  356.         }
  357.         switch -- [lindex $res 0] {
  358.             "build" {
  359.                 set ma [lindex $res 1]
  360.                 if {[llength $res] > 2} {
  361.                     set theotherflags [lrange [lindex $res 2] 1 end]
  362.                     if {[lindex [lindex $res 2] 0] != -1} {
  363.                         set mproc [lindex [lindex $res 2] 0]
  364.                     }
  365.                     if {[lindex $res 3] != ""} {
  366.                         eval lappend msubs [lindex $res 3]
  367.                     }
  368.                     if {[lindex $res 4] != ""} { set name [lindex $res 4] }
  369.                 }
  370.             } "menu" {
  371.                 eval $res
  372.                 return ""
  373.             } default {
  374.                 return ""
  375.             }
  376.         }
  377.     } else {
  378.         set ma ""
  379.         if [info exists menu::items($token)] {
  380.             set ma [set menu::items($token)]
  381.             global menu::proc menu::which_subs menu::otherflags
  382.             if [info exists menu::proc($token)] {
  383.                 set mproc [set menu::proc($token)]
  384.             }
  385.             if [info exists menu::which_subs($token)] {
  386.                 eval lappend msubs [set menu::which_subs($token)]
  387.             }
  388.             if [info exists menu::otherflags($token)] {
  389.                 set theotherflags [set menu::otherflags($token)]
  390.             }
  391.         }
  392.     }
  393.  
  394.     if ![info exists name] { set name $token }
  395.     # add any registered items and make the menu contents
  396.     if [info exists menu::additions($token)] {
  397.         foreach ins [set menu::additions($token)] {
  398.             set where [lindex $ins 1]
  399.             set type [lindex $ins 0]
  400.             set ins [lrange $ins 2 end]
  401.             switch -- $type {
  402.                 "submenu" {
  403.                     lappend msubs [lindex $ins 0]
  404.                     set ins [list [list menu -n [lindex $ins 0] {}]]
  405.                 }
  406.             }
  407.             switch -- [lindex $where 0] {
  408.                 "replace" {
  409.                     set old [lindex $where 1]
  410.                     if {[set ix [eval llindex ma $old]] != -1} {
  411.                         set ma [eval [list lreplace $ma $ix [expr $ix -1 + [llength $old]]] $ins]
  412.                     } else {
  413.                         alertnote "Bad menu::replacement registered '$old'"
  414.                     }
  415.                     
  416.                 }
  417.                 "end" {
  418.                     eval lappend ma $ins
  419.                 }
  420.                 default {
  421.                     set ma [eval linsert [list $ma] $where $ins]
  422.                 }
  423.             }
  424.         }
  425.     }
  426.     regsub -all {"?\(-"?([ \t\r\n]+"?\(-"?)+} $ma "(-" ma
  427.     regsub -all {(^[ \t\r\n]*"?\(-"?|"?\(-"?[ \t\r\n]*$)} $ma "" ma
  428.     # build the menu
  429.     set name [list -n $name]
  430.     if [info exists theotherflags] {
  431.         set name [concat $theotherflags $name]
  432.     }
  433.     if [info exists mproc] {
  434.         if {$mproc != ""} {
  435.             eval menu $name -p $mproc [list $ma]
  436.         } else {
  437.             eval menu $name [list $ma]
  438.         }
  439.     } else {
  440.         eval menu $name -p menu::generalProc [list $ma]
  441.     }
  442.     if [info exists msubs] {
  443.         return $msubs
  444.     }
  445.     return ""
  446. }
  447.  
  448. proc menu::replaceRebuild {name title} {
  449.     global $name
  450.     catch {removeMenu [set $name]}
  451.     set $name $title
  452.     menu::buildSome $name
  453.     insertMenu [set $name]
  454. }
  455.  
  456. proc menu::globalBuild {} {
  457.     global alpha::package_menus package::prefs
  458.     cache::read index::menu
  459.     lappend ma "menus…" \
  460.       {menu -n preferences {}}
  461.     if [info exists alpha::package_menus] {
  462.         global globalMenus_curr
  463.         set i [list menu -n packageMenus -p menu::menuPackages]
  464.         regsub -all "([join $globalMenus_curr |])" \
  465.           [lsort -ignore ${alpha::package_menus}] "!•\\1" j
  466.         lappend ma [concat $i [list $j]]
  467.     }
  468.     lappend ma "editPrefsFile" "(-"
  469.     if [info exists package::prefs] {
  470.         foreach pkg ${package::prefs} {
  471.             lappend ma "${pkg}Prefs…"
  472.         }
  473.     }
  474.     lappend ma "(-" "specialKeys…" "listGlobalBindings" \
  475.       "listPackages" "listAllBindings" "listFunctions" 
  476.     return [list build $ma menu::globalProc preferences]
  477. }
  478.  
  479. proc menu::menuPackages {menu m} {
  480.     if [package::helpOrDescribe $m] {
  481.         return
  482.     }
  483.     # toggle global existence of '$m' menu
  484.     global globalMenus_curr modifiedVars
  485.     if {[set idx [lsearch  $globalMenus_curr $m]] == -1} {
  486.         lappend globalMenus_curr $m
  487.         global $m
  488.         catch $m
  489.         insertMenu [set    $m]
  490.         markMenuItem packageMenus $m 1
  491.     } else {
  492.         set globalMenus_curr [lreplace $globalMenus_curr $idx $idx]
  493.         global $m
  494.         catch "removeMenu [set $m]"
  495.         markMenuItem packageMenus $m 0
  496.     }
  497.     lappend modifiedVars globalMenus_curr
  498. }
  499.  
  500. proc menu::modeBuild {} {
  501.     set ma [list "menus…" "/ppreferences…" "editPrefsFile" \
  502.         "loadPrefsFile…" "describeMode" "(-" "/m<Uchange…"]
  503.     return [list build $ma mode::menuProc "" currentMode]
  504. }
  505.  
  506. proc menu::preferencesBuild {} {
  507.     global flagPrefs
  508.     set ma [list [menu::itemWithIcon "Interface Preferences" 84]]
  509.     lappend ma Tiling Window Wrapping Gui "(-" \
  510.         [menu::itemWithIcon "Standard Preferences" 84]
  511.     lappend ma Backups Electrics Miscellaneous Printer Tags WWW "(-" \
  512.         [menu::itemWithIcon "Other Preferences" 84]
  513.     eval lunion ma [lsort [array names flagPrefs]]
  514.     return [list build $ma {dialog::preferences -m}]
  515. }
  516.  
  517. proc menu::removeFrom {name args} {
  518.     global menu::additions alpha::noMenusYet
  519.     if [info exists menu::additions($name)] {
  520.         if {[set i [lsearch -exact [set menu::additions($name)] $args]] != -1} {
  521.             set menu::additions($name) [lreplace [set menu::additions($name)] $i $i]
  522.             if ![info exists alpha::noMenusYet] {
  523.                 # we were called after start-up; build the menu now
  524.                 menu::buildSome $name
  525.             }
  526.         }
  527.     }
  528. }
  529.  
  530. proc menu::replaceWith {name current type args} {
  531.     global menu::additions alpha::noMenusYet
  532.     if ![info exists menu::additions($name)] {
  533.         lappend menu::additions($name) [concat [list $type [list replace $current]] $args]
  534.     } else {
  535.         set add 1
  536.         set j 0
  537.         foreach i [set menu::additions($name)] {
  538.             if {[lrange $i 0 1] == [list $type [list replace $current]]} {
  539.                 if {[lindex $i 1] != $args} {
  540.                     set add 0
  541.                     set menu::additions($name) \
  542.                       [lreplace [set menu::additions($name)] $j $j \
  543.                       [concat [list $type [list replace $current]] $args]]
  544.                     break
  545.                 } else {
  546.                     # no change
  547.                     return
  548.                 }
  549.             }
  550.             incr j
  551.         }
  552.         if $add {
  553.             lappend menu::additions($name) [concat [list $type [list replace $current]] $args]
  554.         }
  555.     }
  556.     if ![info exists alpha::noMenusYet] {
  557.         # we were called after start-up; build the menu now
  558.         menu::buildSome $name
  559.     }
  560. }
  561.  
  562. proc menu::itemWithIcon {name icon} {
  563.     return "/\x1e${name}^[text::Ascii $icon 1]"
  564. }
  565.  
  566. proc file::open {} {findFile}
  567. proc file::close {} {killWindow}
  568.  
  569. ## 
  570.  # -------------------------------------------------------------------------
  571.  # 
  572.  # "menu::generalProc" --
  573.  # 
  574.  #  If either 'item' or 'menu::item' exists, call it.  Else try and
  575.  #  autoload 'item', if that fails try and autoload 'menu::item'
  576.  # -------------------------------------------------------------------------
  577.  ##
  578. if {[info tclversion] < 8.0} {
  579. proc menu::generalProc {menu item} {
  580.     set menu [string tolower $menu]
  581.     if {[info commands ${menu}::${item}] != ""} {
  582.         uplevel \#0 ${menu}::$item
  583.     } elseif {[info commands $item] != ""} {
  584.         uplevel \#0 $item
  585.     } elseif {[catch {${menu}::$item}]} {
  586.         if {[info commands ${menu}::$item] == ""} {
  587.             uplevel \#0 $item
  588.         }
  589.     }
  590. }
  591. } else {
  592.     proc menu::generalProc {menu item} {
  593.         set menu [string tolower $menu]
  594.         if {[info commands ::${menu}::${item}] != ""} {
  595.             uplevel \#0 ::${menu}::$item
  596.         } elseif {[info commands $item] != ""} {
  597.             uplevel \#0 $item
  598.         } elseif {[catch {::${menu}::$item}]} {
  599.             if {[info commands ::${menu}::$item] == ""} {
  600.                 if {[catch {${menu}::$item}]} {
  601.                     if {[info commands ::${menu}::$item] == ""} {
  602.                         uplevel \#0 $item
  603.                     }
  604.                 }
  605.             }
  606.         }
  607.     }
  608. }
  609.  
  610. proc menu::globalProc {menu item} {
  611.     global package::prefs
  612.     if [regexp "(.*)Prefs" $item d pkg] {
  613.         if [lcontains package::prefs $pkg] {
  614.             dialog::pkg_options $pkg
  615.             return
  616.         }
  617.     }
  618.     menu::generalProc $menu $item
  619. }
  620.  
  621. ## 
  622.  # proc namedClipMenuProc {menu item} {
  623.  #     switch $item {
  624.  #         "copy"      "copyNamedClipboard"
  625.  #         "cut"       "cutNamedClipboard"
  626.  #         "paste"     "pasteNamedClipboard"
  627.  #     }
  628.  # }
  629.  ##
  630.  
  631. proc menu::colorProc {menu item} {
  632.     global colorInds modifiedArrVars
  633.     if {[info exists colorInds($item)]} {
  634.         set color [eval [list colorTriple "New \"$item\":"] $colorInds($item)]
  635.     } else {
  636.         switch -- $item {
  637.             foreground    { set inds "0 0 0" }
  638.             background    { set inds "65535 65535 65535" }
  639.             blue        { set inds "0 0 65535" }
  640.             cyan        { set inds "61404 11464 34250" }
  641.             green        { set inds "1151 33551 8297" }
  642.             magenta        { set inds "44790 1591 51333" }
  643.             red            { set inds "65535 0 0" }
  644.             white        { set inds "65535 65535 65535" }
  645.             yellow        { set inds "61834 64156 12512" }
  646.             default        { set inds "65535 65535 65535" }
  647.         }
  648.         set color [eval [list colorTriple "New \"$item\":"] $inds]
  649.     }
  650.     eval setRGB $item $color
  651.  
  652.     set colorInds($item) $color
  653.     alpha::makeColourList
  654.     lappend modifiedArrVars colorInds
  655. }
  656.  
  657. proc alpha::makeColourList {} {
  658.     global alpha::colors colorInds alpha::basiccolors
  659.     # Set up color indices
  660.     foreach ind [array names colorInds] {
  661.         eval setRGB $ind $colorInds($ind)
  662.     }
  663.     set alpha::basiccolors {none blue cyan green magenta red white yellow}
  664.     set alpha::colors ${alpha::basiccolors}
  665.     foreach c {color_9 color_10 color_11 color_12 color_13 color_14 color_15} {
  666.         if [info exists colorInds($c)] {lappend alpha::colors $c}
  667.     }
  668. }
  669.  
  670.  
  671.         
  672. #===============================================================================
  673. proc helpMenu {item} {
  674.     global HOME
  675.     edit -r -c "$HOME:Help:$item"
  676. }
  677.  
  678. ## 
  679.  # -------------------------------------------------------------------------
  680.  # 
  681.  # "alphaHelp" --
  682.  # 
  683.  #  Called from about box
  684.  # -------------------------------------------------------------------------
  685.  ##
  686. proc alphaHelp {} {
  687.     global HOME
  688.     if [file exists [set f "$HOME:Help:Alpha Manual"]] {
  689.         edit -r -c $f
  690.     } else {
  691.         edit -r -c "$HOME:Help:Quick Start"
  692.     }
  693. }
  694.  
  695. proc register {} {
  696.     global HOME
  697.     launch -f "$HOME:Register"
  698. }
  699.  
  700. namespace eval icon {}
  701. namespace eval file {}
  702.  
  703. proc icon::FromSig {sig} {
  704.     global alpha::_icons
  705.     if {[set p [lsearch -glob ${alpha::_icons} "${sig} *"]] != -1} {
  706.         set p [lindex ${alpha::_icons} $p]
  707.         return [lindex $p 2]
  708.     } else {
  709.         return ""
  710.     }
  711. }
  712.  
  713. proc icon::MenuFromSig {sig} {
  714.     global alpha::_icons
  715.     if {[set p [lsearch -glob ${alpha::_icons} "${sig} *"]] != -1} {
  716.         set char [expr [lindex [lindex ${alpha::_icons} $p] 2] -208]
  717.         if {$char < 1 || $char > 256} { return "" }
  718.         return "^[text::Ascii $char 1]"
  719.     } else {
  720.         return ""
  721.     }
  722. }
  723.  
  724. proc file::getSig {f} {
  725.     if [catch {getFileInfo $f arr}] { return "" }
  726.     return $arr(creator)
  727. }
  728.  
  729.  
  730. proc menu::fileUtils {menu item} {
  731.     if {[lsearch -exact {"insertPathName" "insertFile" "fileRemove" "fileInfo" "wordCount" "textToAlpha"} $item] != -1} {return [$item]}
  732.     switch -- $menu {
  733.         "moreUtils" {
  734.             file::Utils::$item
  735.         }
  736.         default {
  737.             file::$item
  738.         }
  739.     }
  740. }
  741.  
  742. proc menu::winTileProc {menu item} {
  743.     win$item
  744. }
  745.  
  746. proc menu::reinterpretOldMenu {args} {
  747.     set ma [lindex $args end]
  748.     set args [lreplace $args end end]
  749.     getOpts {-n -M -p}
  750.     if [info exists opts(-p)] {
  751.         lappend proc $opts(-p)
  752.     } else {
  753.         lappend proc "-1"
  754.     }
  755.     if [info exists opts(-M)] { lappend proc -M $opts(-m) }
  756.     if [info exists opts(-m)] { lappend proc -m }
  757.     menu::buildOne $opts(-n) build $ma $proc
  758. }
  759.